home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / prodpack.zip / DB4PPSRC.EXE / _DLEXEC.PRG < prev    next >
Text File  |  1993-05-04  |  8KB  |  303 lines
  1. PROCEDURE _DLExec
  2. PARAMETERS pc_panel, pc_file
  3. *---------------------------------------------------------------------
  4. * NAME
  5. *   _FXExec - Control Center Execution program for the Forms panel
  6. *
  7. * DESCRIPTION
  8. *   _FXExec is the <execution> program for the Control Center when
  9. *   executed from the Forms panel.  _FXExec performs the tasks that
  10. *   the Control Center would normally perform if the <execution>
  11. *   program was not assigned.  These functions are as follows:
  12. *
  13. *   - Check to see if a database or view is in use
  14. *   - If not open,
  15. *     + Open the database or view
  16. *   - Otherwise
  17. *     + Check to see if the file open is the one assigned to the catalog
  18. *     + If not,
  19. *       - Display the dialog box indicating current view or DBF/QBE name
  20. *       - Use the database or view selected by the user
  21. *   - If its a nornal SCR, FMO, or FMT file, SET FORMAT TO it
  22. *   - Otherwise,
  23. *     + Is TAG field for SCR object set to "PRG"
  24. *       - Run the SCR file as a PRG for multi-file forms, return to master
  25. *     + If the object file a PRG, if so, do it, and return to master
  26. *
  27. * PARAMETERS
  28. *   pc_panel = "FORM" for forms panel
  29. *   pc_file  = name of the file selected with full path
  30. *---------------------------------------------------------------------
  31.   SET ECHO OFF
  32.  
  33.   PRIVATE lc_err, lc_fullpre, lc_quess, lc_scbname, lc_scrext, lc_trypath, ;
  34.           ll_dbtrap, ll_loaded, ll_talk, lc_ctnm
  35.  
  36.   ll_talk = _TalkMode( .F. )
  37.   lc_ctnm = CATALOG()
  38.  
  39.   PUBLIC fxl_escape, fxl_exact, fxl_fields, fxl_near, fxl_safety, fxc_dbtrap, ;
  40.          fxl_isscb, fxc_mastdb, fxl_talk, fxl_trap
  41.  
  42.   STORE .F. TO fxl_talk, ;
  43.     fxl_near, ;
  44.     fxl_exact, ;
  45.     fxl_safety, ;
  46.     fxl_escape, ;
  47.     fxl_fields, ;
  48.     fxl_trap
  49.  
  50.   DO _FXEcSEnv                          && Set the operating environment
  51.   fxl_talk = ll_talk
  52.  
  53.   IF .NOT. FILE( pc_file )
  54.  
  55.     lc_quess = _FileRoot( pc_file ) + "." + _FileType( pc_file )
  56.     lc_trypath = _FFile( lc_quess )
  57.     IF .NOT. ISBLANK( lc_trypath )
  58.  
  59.       pc_file = lc_trypath + lc_quess
  60.  
  61.       IF .NOT. FILE( pc_file )
  62.         DO _Err_Box WITH [Cannot locate design file based on path: ] + pc_file
  63.         IF LASTKEY() = 28
  64.           DO _Helpsys WITH "_FXZERR", "XXNOSCR"
  65.         ENDIF
  66.  
  67.         DO _FXEcREnv                    && Restore the operating environment
  68.         IF _TalkMode( ll_talk )
  69.         ENDIF
  70.  
  71.         RETURN TO MASTER
  72.  
  73.       ENDIF
  74.  
  75.     ENDIF
  76.  
  77.   ENDIF
  78.  
  79.   lc_err = [Do not know what to do with file: ]
  80.  
  81.   *-- Determine if the form has any Special F/X
  82.   fxc_dbtrap = ""
  83.   fxl_isscb = .T.
  84.  
  85.   fxc_dbtrap = SET( "DBTRAP" )
  86.   SET DBTRAP OFF
  87.  
  88.   ll_dbtrap = SET( "DBTRAP" ) = "ON"
  89.   SET DBTRAP OFF
  90.   ll_loaded = .F.
  91.  
  92.   DO _SetOnEr
  93.   DO _fxUseIt WITH pc_file, ll_loaded, fxl_isscb
  94.   ON ERROR
  95.  
  96.   IF ll_dbtrap
  97.     SET DBTRAP ON
  98.   ENDIF
  99.  
  100.   IF .NOT. ll_loaded .AND. ISBLANK( FXC_CTAG )
  101.  
  102.     IF ISBLANK( ALIAS() )
  103.  
  104.       DO _Err_Box WITH [No database in use, returning back to Control Center]
  105.       IF LASTKEY() = 28
  106.         DO _Helpsys WITH "_FXZERR", "XXNODBF"
  107.       ENDIF
  108.  
  109.     ENDIF
  110.  
  111.     IF fxl_isscb .AND. fxc_dbtrap = "ON"
  112.       SET DBTRAP ON
  113.     ENDIF
  114.  
  115.     RELEASE FXC_ctag
  116.  
  117.     DO _FXEcREnv                        && Reset the operating environment
  118.  
  119.     RETURN TO MASTER                    && Exit without going to EDIT/BROWSE
  120.  
  121.   ENDIF
  122.  
  123.   lc_fullpre = pc_file
  124.   DO _FullPre WITH lc_fullpre
  125.  
  126.   lc_scrext = _FileType( pc_file )
  127.  
  128.   fxc_mastdb = ALIAS()
  129.   FXC_qrep = lc_fullpre
  130.  
  131.   *-- Execute the SET FORMAT or DO based on the file type
  132.   DO CASE
  133.  
  134.     CASE lc_scrext $ "SCR,FMT,FMO"
  135.  
  136.       IF ISBLANK( FXC_ctag )
  137.  
  138.         *-- Normal EDIT/BROWSE format file
  139.         IF FILE( lc_fullpre + ".FMT" ) .OR. FILE( lc_fullpre + ".FMO" )
  140.  
  141.           SET FORMAT TO ( lc_fullpre )
  142.  
  143.           IF fxl_isscb
  144.  
  145.             RELEASE FXL_Edit
  146.             PUBLIC FXL_Edit
  147.             FXL_Edit = .T.
  148.             DO _SetOnEr
  149.  
  150.             EDIT
  151.  
  152.             IF TYPE("FXL_ERROR") = "L" .AND. FXL_ERROR
  153.               *-- Start clearing .dbf out of all other workareas past 1
  154.               CLOSE DATABASES
  155.               IF .NOT. ISBLANK( fxc_mastdb )
  156.                 DO _OpenDBF WITH fxc_mastdb, 1, .T.
  157.               ENDIF
  158.             ENDIF
  159.             ON ERROR
  160.             RELEASE FXL_Edit, FXL_Error
  161.  
  162.             IF fxl_isscb .AND. fxc_dbtrap = "ON"
  163.               SET DBTRAP ON
  164.             ENDIF
  165.  
  166.             RELEASE FXC_ctag
  167.  
  168.             DO _FXEcREnv                && Reset the operating environment
  169.             RETURN TO MASTER            && Exit without going to EDIT/BROWSE
  170.  
  171.           ENDIF
  172.  
  173.         ELSE
  174.  
  175.           DO _Err_Box WITH [File not found: ] + lc_fullpre + ".FMT"
  176.           IF LASTKEY() = 28
  177.             DO _Helpsys WITH "_FXZERR", "XXNOFMT"
  178.           ENDIF
  179.  
  180.           IF fxl_isscb .AND. fxc_dbtrap = "ON"
  181.             SET DBTRAP ON
  182.           ENDIF
  183.  
  184.           RELEASE FXC_ctag
  185.  
  186.           DO _FXEcREnv                  && Reset the operating environment
  187.  
  188.           RETURN TO MASTER              && Exit without going to EDIT/BROWSE
  189.  
  190.         ENDIF
  191.  
  192.       ELSE
  193.  
  194.         *-- Check for multi-file/multi-record form
  195.         IF FXC_ctag = "DLG"
  196.           *-- It is, so run the SCR as a PRG
  197.           IF FILE( lc_fullpre + ".PRG" )
  198.  
  199.             RELEASE FXL_Edit
  200.             PUBLIC FXL_Edit
  201.             FXL_Edit = .F. 
  202.  
  203.             DO _SetOnEr                 && Set on error based on FXL_DEV
  204.             IF TYPE( "FXL_DEV" ) = "L" .AND. FXL_DEV
  205.               SET TRAP ON
  206.               SET ESCAPE ON
  207.             ELSE
  208.               SET TRAP OFF
  209.               SET ESCAPE OFF
  210.             ENDIF
  211.  
  212.             RELEASE cColorEnv
  213.             PUBLIC cColorEnv
  214.             cColorEnv = SET( "ATTRIB" )
  215.  
  216.             lcPrgName = _FileRoot( pc_file )
  217.             DO &lcPrgName
  218.  
  219.             IF TYPE("FXL_ERROR") = "L" .AND. FXL_ERROR
  220.               *-- Start clearing .dbf out of all other workareas past 1
  221.               CLOSE DATABASES
  222.               IF .NOT. ISBLANK( fxc_mastdb )
  223.                 DO _OpenDBF WITH fxc_mastdb, 1, .T.
  224.               ENDIF
  225.               SET CURSOR ON
  226.               cColorPost = _ColorSet( cColorEnv )
  227.             ENDIF
  228.             RELEASE cColorEnv
  229.             ON ERROR
  230.             RELEASE FXL_Edit, FXL_Error
  231.  
  232.           ELSE
  233.  
  234.             DO _Err_Box WITH [File not found: ] + lc_fullpre + ".PRG"
  235.             IF LASTKEY() = 28
  236.               DO _Helpsys WITH "_FXZERR", "XXNOPRG"
  237.             ENDIF
  238.  
  239.           ENDIF
  240.  
  241.           IF fxl_isscb .AND. fxc_dbtrap = "ON"
  242.             SET DBTRAP ON
  243.           ENDIF
  244.  
  245.           IF .NOT. ISBLANK( lc_ctnm )
  246.             SET CATALOG TO &lc_ctnm
  247.           ENDIF
  248.           SELECT 1
  249.  
  250.           RELEASE FXC_ctag
  251.  
  252.           DO _FXEcREnv                  && Reset the operating environment
  253.  
  254.           SELECT 1                      && All this is to get the catalog
  255.           IF .NOT. ISBLANK( ALIAS() )   && to put the file in use, back
  256.             USE ( ALIAS() )             && above the line.
  257.           ENDIF
  258.  
  259.           RETURN TO MASTER              && Exit without going to EDIT/BROWSE
  260.  
  261.         ELSE
  262.  
  263.           DO _Err_Box WITH lc_err + pc_file
  264.           IF LASTKEY() = 28
  265.             DO _Helpsys WITH "_FXZERR", "XXUNKFIL"
  266.           ENDIF
  267.  
  268.         ENDIF
  269.  
  270.       ENDIF
  271.  
  272.     OTHERWISE
  273.  
  274.       *-- Don't recognize the file type, go to EDIT/BROWSE without FORMAT
  275.       DO _Err_Box WITH lc_err + pc_file
  276.       IF LASTKEY() = 28
  277.         DO _Helpsys WITH "_FXZERR", "XXUNKFIL"
  278.       ENDIF
  279.  
  280.       RELEASE FXC_ctag
  281.  
  282.       DO _FXEcREnv                      && Reset the operating environment
  283.  
  284.       RETURN TO MASTER                  && Exit without going to EDIT/BROWSE
  285.  
  286.   ENDCASE
  287.  
  288.   RELEASE FXC_ctag
  289.  
  290.   IF fxc_dbtrap = "ON"
  291.     SET DBTRAP ON
  292.   ENDIF
  293.  
  294.   DO _FXEcREnv                          && Reset the operating environment
  295.  
  296. RETURN
  297. *-- EOP: _DLExec WITH pc_panel, pc_file
  298.  
  299.  
  300.  
  301.  
  302. 
  303.